home *** CD-ROM | disk | FTP | other *** search
/ Ultra Pack / UltraComputing Partner Applications.iso / SunLabs / tclTK / src / tk4.0 / tkMain.c < prev    next >
Encoding:
C/C++ Source or Header  |  1995-06-08  |  12.0 KB  |  462 lines
  1. /* 
  2.  * tkMain.c --
  3.  *
  4.  *    This file contains a generic main program for Tk-based applications.
  5.  *    It can be used as-is for many applications, just by supplying a
  6.  *    different appInitProc procedure for each specific application.
  7.  *    Or, it can be used as a template for creating new main programs
  8.  *    for Tk applications.
  9.  *
  10.  * Copyright (c) 1990-1994 The Regents of the University of California.
  11.  * Copyright (c) 1994-1995 Sun Microsystems, Inc.
  12.  *
  13.  * See the file "license.terms" for information on usage and redistribution
  14.  * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
  15.  */
  16.  
  17. static char sccsid[] = "@(#) tkMain.c 1.114 95/06/08 11:43:00";
  18.  
  19. #include <ctype.h>
  20. #include <stdio.h>
  21. #include <string.h>
  22. #include <tcl.h>
  23. #include <tk.h>
  24. #ifdef NO_STDLIB_H
  25. #   include "compat/stdlib.h"
  26. #else
  27. #   include <stdlib.h>
  28. #endif
  29.  
  30. /*
  31.  * Declarations for various library procedures and variables (don't want
  32.  * to include tkInt.h or tkPort.h here, because people might copy this
  33.  * file out of the Tk source directory to make their own modified versions).
  34.  * Note: don't declare "exit" here even though a declaration is really
  35.  * needed, because it will conflict with a declaration elsewhere on
  36.  * some systems.
  37.  */
  38.  
  39. extern int        isatty _ANSI_ARGS_((int fd));
  40. extern int        read _ANSI_ARGS_((int fd, char *buf, size_t size));
  41. extern char *        strrchr _ANSI_ARGS_((CONST char *string, int c));
  42.  
  43. /*
  44.  * Global variables used by the main program:
  45.  */
  46.  
  47. static Tk_Window mainWindow;    /* The main window for the application.  If
  48.                  * NULL then the application no longer
  49.                  * exists. */
  50. static Tcl_Interp *interp;    /* Interpreter for this application. */
  51. static Tcl_DString command;    /* Used to assemble lines of terminal input
  52.                  * into Tcl commands. */
  53. static int tty;            /* Non-zero means standard input is a
  54.                  * terminal-like device.  Zero means it's
  55.                  * a file. */
  56. static char errorExitCmd[] = "exit 1";
  57.  
  58. /*
  59.  * Command-line options:
  60.  */
  61.  
  62. static int synchronize = 0;
  63. static char *fileName = NULL;
  64. static char *name = NULL;
  65. static char *display = NULL;
  66. static char *geometry = NULL;
  67.  
  68. static Tk_ArgvInfo argTable[] = {
  69.     {"-display", TK_ARGV_STRING, (char *) NULL, (char *) &display,
  70.     "Display to use"},
  71.     {"-geometry", TK_ARGV_STRING, (char *) NULL, (char *) &geometry,
  72.     "Initial geometry for window"},
  73.     {"-name", TK_ARGV_STRING, (char *) NULL, (char *) &name,
  74.     "Name to use for application"},
  75.     {"-sync", TK_ARGV_CONSTANT, (char *) 1, (char *) &synchronize,
  76.     "Use synchronous mode for display server"},
  77.     {(char *) NULL, TK_ARGV_END, (char *) NULL, (char *) NULL,
  78.     (char *) NULL}
  79. };
  80.  
  81. /*
  82.  * Forward declarations for procedures defined later in this file:
  83.  */
  84.  
  85. static void        Prompt _ANSI_ARGS_((Tcl_Interp *interp, int partial));
  86. static void        StdinProc _ANSI_ARGS_((ClientData clientData,
  87.                 int mask));
  88.  
  89. /*
  90.  *----------------------------------------------------------------------
  91.  *
  92.  * Tk_Main --
  93.  *
  94.  *    Main program for Wish and most other Tk-based applications.
  95.  *
  96.  * Results:
  97.  *    None. This procedure never returns (it exits the process when
  98.  *    it's done.
  99.  *
  100.  * Side effects:
  101.  *    This procedure initializes the Tk world and then starts
  102.  *    interpreting commands;  almost anything could happen, depending
  103.  *    on the script being interpreted.
  104.  *
  105.  *----------------------------------------------------------------------
  106.  */
  107.  
  108. void
  109. Tk_Main(argc, argv, appInitProc)
  110.     int argc;                /* Number of arguments. */
  111.     char **argv;            /* Array of argument strings. */
  112.     Tcl_AppInitProc *appInitProc;    /* Application-specific initialization
  113.                      * procedure to call after most
  114.                      * initialization but before starting
  115.                      * to execute commands. */
  116. {
  117.     char *args, *p, *msg, *argv0, *class;
  118.     char buf[20];
  119.     int code;
  120.     size_t length;
  121.  
  122.     interp = Tcl_CreateInterp();
  123. #ifdef TCL_MEM_DEBUG
  124.     Tcl_InitMemory(interp);
  125. #endif
  126.  
  127.     /*
  128.      * Parse command-line arguments.  A leading "-file" argument is
  129.      * ignored (a historical relic from the distant past).  If the
  130.      * next argument doesn't start with a "-" then strip it off and
  131.      * use it as the name of a script file to process.  Also check
  132.      * for other standard arguments, such as "-geometry", anywhere
  133.      * in the argument list.
  134.      */
  135.  
  136.     argv0 = argv[0];
  137.     if (argc > 1) {
  138.     length = strlen(argv[1]);
  139.     if ((length >= 2) && (strncmp(argv[1], "-file", length) == 0)) {
  140.         argc--;
  141.         argv++;
  142.     }
  143.     }
  144.     if ((argc > 1) && (argv[1][0] != '-')) {
  145.     fileName = argv[1];
  146.     argc--;
  147.     argv++;
  148.     }
  149.     if (Tk_ParseArgv(interp, (Tk_Window) NULL, &argc, argv, argTable, 0)
  150.         != TCL_OK) {
  151.     fprintf(stderr, "%s\n", interp->result);
  152.     exit(1);
  153.     }
  154.     if (name == NULL) {
  155.     if (fileName != NULL) {
  156.         p = fileName;
  157.     } else {
  158.         p = argv[0];
  159.     }
  160.     name = strrchr(p, '/');
  161.     if (name != NULL) {
  162.         name++;
  163.     } else {
  164.         name = p;
  165.     }
  166.     }
  167.  
  168.     /*
  169.      * Make command-line arguments available in the Tcl variables "argc"
  170.      * and "argv".
  171.      */
  172.  
  173.     args = Tcl_Merge(argc-1, argv+1);
  174.     Tcl_SetVar(interp, "argv", args, TCL_GLOBAL_ONLY);
  175.     ckfree(args);
  176.     sprintf(buf, "%d", argc-1);
  177.     Tcl_SetVar(interp, "argc", buf, TCL_GLOBAL_ONLY);
  178.     Tcl_SetVar(interp, "argv0", (fileName != NULL) ? fileName : argv0,
  179.         TCL_GLOBAL_ONLY);
  180.  
  181.     /*
  182.      * If a display was specified, put it into the DISPLAY
  183.      * environment variable so that it will be available for
  184.      * any sub-processes created by us.
  185.      */
  186.  
  187.     if (display != NULL) {
  188.     Tcl_SetVar2(interp, "env", "DISPLAY", display, TCL_GLOBAL_ONLY);
  189.     }
  190.  
  191.     /*
  192.      * Initialize the Tk application.  If a -name option was provided,
  193.      * use it;  otherwise, if a file name was provided, use the last
  194.      * element of its path as the name of the application; otherwise
  195.      * use the last element of the program name.  For the application's
  196.      * class, capitalize the first letter of the name.
  197.      */
  198.  
  199.     if (name == NULL) {
  200.     p = (fileName != NULL) ? fileName : argv0;
  201.     name = strrchr(p, '/');
  202.     if (name != NULL) {
  203.         name++;
  204.     } else {
  205.         name = p;
  206.     }
  207.     }
  208.     class = (char *) ckalloc((unsigned) (strlen(name) + 1));
  209.     strcpy(class, name);
  210.     class[0] = toupper((unsigned char) class[0]);
  211.     mainWindow = Tk_CreateMainWindow(interp, display, name, class);
  212.     ckfree(class);
  213.     if (mainWindow == NULL) {
  214.     fprintf(stderr, "%s\n", interp->result);
  215.     exit(1);
  216.     }
  217.     if (synchronize) {
  218.     XSynchronize(Tk_Display(mainWindow), True);
  219.     }
  220.  
  221.     /*
  222.      * Set the "tcl_interactive" variable.
  223.      */
  224.  
  225.     tty = isatty(0);
  226.     Tcl_SetVar(interp, "tcl_interactive",
  227.         ((fileName == NULL) && tty) ? "1" : "0", TCL_GLOBAL_ONLY);
  228.  
  229.     /*
  230.      * Set the geometry of the main window, if requested.  Put the
  231.      * requested geometry into the "geometry" variable.
  232.      */
  233.  
  234.     if (geometry != NULL) {
  235.     Tcl_SetVar(interp, "geometry", geometry, TCL_GLOBAL_ONLY);
  236.     code = Tcl_VarEval(interp, "wm geometry . ", geometry, (char *) NULL);
  237.     if (code != TCL_OK) {
  238.         fprintf(stderr, "%s\n", interp->result);
  239.     }
  240.     }
  241.  
  242.     /*
  243.      * Invoke application-specific initialization.
  244.      */
  245.  
  246.     if ((*appInitProc)(interp) != TCL_OK) {
  247.     fprintf(stderr, "application-specific initialization failed: %s\n",
  248.         interp->result);
  249.     }
  250.  
  251.     /*
  252.      * Invoke the script specified on the command line, if any.
  253.      */
  254.  
  255.     if (fileName != NULL) {
  256.     code = Tcl_VarEval(interp, "source ", fileName, (char *) NULL);
  257.     if (code != TCL_OK) {
  258.         goto error;
  259.     }
  260.     tty = 0;
  261.     } else {
  262.     /*
  263.      * Commands will come from standard input, so set up an event
  264.      * handler for standard input.  Evaluate the .rc file, if one
  265.      * has been specified, set up an event handler for standard
  266.      * input, and print a prompt if the input device is a terminal.
  267.      */
  268.  
  269.     if (tcl_RcFileName != NULL) {
  270.         Tcl_DString buffer;
  271.         char *fullName;
  272.         FILE *f;
  273.     
  274.         fullName = Tcl_TildeSubst(interp, tcl_RcFileName, &buffer);
  275.         if (fullName == NULL) {
  276.         fprintf(stderr, "%s\n", interp->result);
  277.         } else {
  278.         f = fopen(fullName, "r");
  279.         if (f != NULL) {
  280.             code = Tcl_EvalFile(interp, fullName);
  281.             if (code != TCL_OK) {
  282.             fprintf(stderr, "%s\n", interp->result);
  283.             }
  284.             fclose(f);
  285.         }
  286.         }
  287.         Tcl_DStringFree(&buffer);
  288.     }
  289.     Tk_CreateFileHandler(0, TK_READABLE, StdinProc, (ClientData) 0);
  290.     if (tty) {
  291.         Prompt(interp, 0);
  292.     }
  293.     }
  294.     fflush(stdout);
  295.     Tcl_DStringInit(&command);
  296.     Tcl_ResetResult(interp);
  297.  
  298.     /*
  299.      * Loop infinitely, waiting for commands to execute.  When there
  300.      * are no windows left, Tk_MainLoop returns and we exit.
  301.      */
  302.  
  303.     Tk_MainLoop();
  304.  
  305.     /*
  306.      * Don't exit directly, but rather invoke the Tcl "exit" command.
  307.      * This gives the application the opportunity to redefine "exit"
  308.      * to do additional cleanup.
  309.      */
  310.  
  311.     Tcl_Eval(interp, "exit");
  312.     exit(1);
  313.  
  314. error:
  315.     msg = Tcl_GetVar(interp, "errorInfo", TCL_GLOBAL_ONLY);
  316.     if (msg == NULL) {
  317.     msg = interp->result;
  318.     }
  319.     fprintf(stderr, "%s\n", msg);
  320.     Tcl_Eval(interp, errorExitCmd);
  321. }
  322.  
  323. /*
  324.  *----------------------------------------------------------------------
  325.  *
  326.  * StdinProc --
  327.  *
  328.  *    This procedure is invoked by the event dispatcher whenever
  329.  *    standard input becomes readable.  It grabs the next line of
  330.  *    input characters, adds them to a command being assembled, and
  331.  *    executes the command if it's complete.
  332.  *
  333.  * Results:
  334.  *    None.
  335.  *
  336.  * Side effects:
  337.  *    Could be almost arbitrary, depending on the command that's
  338.  *    typed.
  339.  *
  340.  *----------------------------------------------------------------------
  341.  */
  342.  
  343.     /* ARGSUSED */
  344. static void
  345. StdinProc(clientData, mask)
  346.     ClientData clientData;        /* Not used. */
  347.     int mask;                /* Not used. */
  348. {
  349. #define BUFFER_SIZE 4000
  350.     char input[BUFFER_SIZE+1];
  351.     static int gotPartial = 0;
  352.     char *cmd;
  353.     int code, count;
  354.  
  355.     count = read(fileno(stdin), input, BUFFER_SIZE);
  356.     if (count <= 0) {
  357.     if (!gotPartial) {
  358.         if (tty) {
  359.         Tcl_Eval(interp, "exit");
  360.         exit(1);
  361.         } else {
  362.         Tk_DeleteFileHandler(0);
  363.         }
  364.         return;
  365.     } else {
  366.         count = 0;
  367.     }
  368.     }
  369.     cmd = Tcl_DStringAppend(&command, input, count);
  370.     if (count != 0) {
  371.     if ((input[count-1] != '\n') && (input[count-1] != ';')) {
  372.         gotPartial = 1;
  373.         goto prompt;
  374.     }
  375.     if (!Tcl_CommandComplete(cmd)) {
  376.         gotPartial = 1;
  377.         goto prompt;
  378.     }
  379.     }
  380.     gotPartial = 0;
  381.  
  382.     /*
  383.      * Disable the stdin file handler while evaluating the command;
  384.      * otherwise if the command re-enters the event loop we might
  385.      * process commands from stdin before the current command is
  386.      * finished.  Among other things, this will trash the text of the
  387.      * command being evaluated.
  388.      */
  389.  
  390.     Tk_CreateFileHandler(0, 0, StdinProc, (ClientData) 0);
  391.     code = Tcl_RecordAndEval(interp, cmd, TCL_EVAL_GLOBAL);
  392.     Tk_CreateFileHandler(0, TK_READABLE, StdinProc, (ClientData) 0);
  393.     Tcl_DStringFree(&command);
  394.     if (*interp->result != 0) {
  395.     if ((code != TCL_OK) || (tty)) {
  396.         /*
  397.          * The statement below used to call "printf", but that resulted
  398.          * in core dumps under Solaris 2.3 if the result was very long.
  399.          */
  400.  
  401.         puts(interp->result);
  402.     }
  403.     }
  404.  
  405.     /*
  406.      * Output a prompt.
  407.      */
  408.  
  409.     prompt:
  410.     if (tty) {
  411.     Prompt(interp, gotPartial);
  412.     }
  413.     Tcl_ResetResult(interp);
  414. }
  415.  
  416. /*
  417.  *----------------------------------------------------------------------
  418.  *
  419.  * Prompt --
  420.  *
  421.  *    Issue a prompt on standard output, or invoke a script
  422.  *    to issue the prompt.
  423.  *
  424.  * Results:
  425.  *    None.
  426.  *
  427.  * Side effects:
  428.  *    A prompt gets output, and a Tcl script may be evaluated
  429.  *    in interp.
  430.  *
  431.  *----------------------------------------------------------------------
  432.  */
  433.  
  434. static void
  435. Prompt(interp, partial)
  436.     Tcl_Interp *interp;            /* Interpreter to use for prompting. */
  437.     int partial;            /* Non-zero means there already
  438.                      * exists a partial command, so use
  439.                      * the secondary prompt. */
  440. {
  441.     char *promptCmd;
  442.     int code;
  443.  
  444.     promptCmd = Tcl_GetVar(interp,
  445.     partial ? "tcl_prompt2" : "tcl_prompt1", TCL_GLOBAL_ONLY);
  446.     if (promptCmd == NULL) {
  447.     defaultPrompt:
  448.     if (!partial) {
  449.         fputs("% ", stdout);
  450.     }
  451.     } else {
  452.     code = Tcl_Eval(interp, promptCmd);
  453.     if (code != TCL_OK) {
  454.         Tcl_AddErrorInfo(interp,
  455.             "\n    (script that generates prompt)");
  456.         fprintf(stderr, "%s\n", interp->result);
  457.         goto defaultPrompt;
  458.     }
  459.     }
  460.     fflush(stdout);
  461. }
  462.